39 lines
3.5 KiB
Mathematica
39 lines
3.5 KiB
Mathematica
DGOREL1 ;ALB/MAC - PATIENT OUTPUT BY RELIGIOUS AFFILIATIONS (Cont.) ; 5 JUL 88@12:00
|
|
;;5.3;Registration;**162**;Aug 13, 1993
|
|
START D NOW^%DTC S Y=$E(%,1,12) S DGDT=$$FMTE^XLFDT(Y,1),(DGJ,DGJJ,DGP,DFN,DGW,DGF,DGFLAG,DGU,DGRM)=0,$P(DGCL,"*",81)="",$P(DGCL1,"-",81)=""
|
|
I DGL="D" F DGDA=DGBEG:0 S DGDA=$O(^DGPM("AMV1",DGDA)) Q:'DGDA F DFN=0:0 S DFN=$O(^DGPM("AMV1",DGDA,DFN)) Q:'DFN F DGCA=0:0 S DGCA=$O(^DGPM("AMV1",DGDA,DFN,DGCA)) Q:'DGCA I $D(^DGPM(DGCA,0)) I DGDA<DGEND D SET1
|
|
I DGL="D" G PR
|
|
F X1=0:0 S DGW=$S(VAUTW:$O(^DPT("CN",DGW)),1:$O(VAUTW(DGW))) Q:DGW=""!(DGU) D DIV,DGSET:'DGF
|
|
PR I $D(^UTILITY($J,"DGC")) S DGFL=0,DGPG=0 D:IOST?1"C-".E&(DGFLAG) RET I 'DGU D DGUTIL
|
|
I '$D(^UTILITY($J,"DGC")) W !,"=====>NO PATIENTS FOUND"
|
|
G QUIT
|
|
DIV S DGDN=$O(^DIC(42,"B",DGW,0)) Q:DGDN="" I $D(^DIC(42,DGDN,0)) S DGDN=$P(^DIC(42,DGDN,0),"^",11),DGF=$S('VAUTD&('$D(VAUTD(+DGDN))):1,1:0) S DGD=$S(DGDN="":"ZNOT SPECIFIED",1:$P(^DG(40.8,DGDN,0),"^",1))
|
|
Q
|
|
DGUTIL S (DGD,DGW)=0
|
|
F J1=0:0 S DGD=$O(^UTILITY($J,"DGC",DGD)) Q:DGD=""!(DGU) D
|
|
. F D1=0:0 S DGW=$O(^UTILITY($J,"DGC",DGD,DGW)) Q:DGW=""!(DGU) D RET:DGJ=-1 Q:DGU S DGPG=0 D HEAD F P1=0:0 S DGJ=$O(^UTILITY($J,"DGC",DGD,DGW,DGJ)) S:DGJ="" DGJ=-1 Q:DGJ<0!(DGU) D RELP,CONT
|
|
Q
|
|
CONT F D1=0:0 S DGP=$O(^UTILITY($J,"DGC",DGD,DGW,DGJ,DGP)) Q:DGP=""!(DGU) F DFN=0:0 S DFN=$O(^UTILITY($J,"DGC",DGD,DGW,DGJ,DGP,DFN)) Q:'DFN!(DGU) S DGUT=^(DFN) D DGPR W !
|
|
Q
|
|
DGSET F DFN=0:0 S DFN=$O(^DPT("CN",DGW,DFN)) Q:'DFN S DGCA=^(DFN) Q:'$D(^DGPM(+DGCA,0)) I $P(^DGPM(DGCA,0),"^",2)=1 S DGAD=^(0) D SET
|
|
Q
|
|
SET1 S DGDD=$P(^DGPM(DGCA,0),"^",17) I DGDD]"" Q:+^DGPM(+DGDD,0)<DGEND
|
|
S DGAD=^DGPM(DGCA,0) Q:'$D(^DPT(DFN,.1)) S DGW=^(.1) Q:DGW="" Q:('VAUTW)&('$D(VAUTW(DGW))) D DIV Q:DGF
|
|
SET S DGDAT=^DPT(DFN,0),DGREL=$S($D(^DIC(13,+$P(DGDAT,"^",8),0)):$P(^(0),"^",1),1:"ZNOT SPECIFIED") Q:DGNON=2&(DGREL="ZNOT SPECIFIED") I $D(DGR) Q:DGR'=DGREL
|
|
D PID^VADPT6 S DGRM=$S($D(^DPT(DFN,.101)):^(.101),1:"") I DGHOW["W" S ^UTILITY($J,"DGC",$E(DGD,1,20),$E(DGW,1,20),$E(DGREL,1,19),$E($P(DGDAT,"^",1),1,20),DFN)=$P(DGDAT,"^",1)_"^"_VA("PID")_"^"_+DGAD_"^"_DGRM Q
|
|
S ^UTILITY($J,"DGC",$E(DGD,1,20),$E(DGREL,1,19),$E(DGW,1,20),$E($P(DGDAT,"^",1),1,20),DFN)=$P(DGDAT,"^",1)_"^"_VA("PID")_"^"_+DGAD_"^"_DGRM Q
|
|
Q
|
|
RET Q:IOST'?1"C-".E F X=$Y:1:(IOSL-2) W !
|
|
R ?22,"Enter <RET> to continue or ^ to QUIT ",X:DTIME S:X["^"!('$T) DGU=1 Q:DGU S DGFLAG=1 Q
|
|
RELP I $Y+6>IOSL D RET:(IOST?1"C-".E) Q:DGU D HEAD
|
|
W:DGFL DGCL1 W !,$S(DGHOW["W":"RELIGION: ",1:"WARD: "),$S(DGJ'="ZNOT SPECIFIED":DGJ,1:$E(DGJ,2,14)),! S DGFL=1 Q
|
|
DGPR D:$Y+4>IOSL RELP Q:DGU W ?3,$P(DGUT,"^",4),?15,$P(DGUT,"^",1),?40,$P(DGUT,"^",2),?58 S Y=$P(DGUT,"^",3) X ^DD("DD") W Y Q
|
|
HEAD S DGPG=DGPG+1 W @IOF,!?3,"DIVISION: ",$S(DGD="ZNOT SPECIFIED":"NOT SPECIFIED",1:DGD),?50,DGDT,?63," PAGE ",DGPG,!?24,"INPATIENT RELIGIOUS AFFILIATIONS",!
|
|
S DGSP="LISTING BY "_$S(DGHOW["W":"WARD - ",1:"FAITH - ")_$S(DGW'="ZNOT SPECIFIED":DGW,1:$E(DGW,2,14)),DGSP1=40-($L(DGSP)/2)\1,DGFL=0 W ?DGSP1,DGSP,!
|
|
I DGL="D" S DGT=$S(DGBEG1=DGEND1:"FOR ",1:"FROM ") S DGT=DGT_$$FMTE^XLFDT(DGBEG1,"1D") I DGEND1'=DGBEG1 S DGT=DGT_" TO "_$$FMTE^XLFDT(DGEND1,"1D")
|
|
I DGL="C" S DGT="FOR "_$P(DGDT,"@",1)
|
|
S DGY=40-($L(DGT)/2) W ?DGY,DGT,!!?4,"ROOM",?20,"PATIENT",?43,"PT ID",?60,"ADMISSION DATE",!,DGCL Q
|
|
QUIT D CLOSE^DGUTQ
|
|
QUIT1 K %,D1,DIC,DFN,DGAD,DGBEG,DGBEG1,DGCA,DGCL,DGCL1,DGDAT,DGDT,DGF,DGD,DGDN,DGDV,DGEND,DGEND1,DGFL,DGFLAG,DGHOW,DGJ,DGJJ,DGL,DGN,DGNON,DGP,DGPG,DGPGM,DGR,DGREL,DGRM
|
|
K DGDA,DGDD,DGSP,DGSP1,DGT,DGU,DGUT,DGVAR,DGW,DGWN,DGY,J1,P1,POP,VA("BID"),VA("PID"),VAUTD,VADAT,VADATE,VAUTNI,VAUTW,I,X,X1,Y,Z,^UTILITY($J,"DGC") Q
|