APCLOS6 ; IHS/CMI/LAB - INHOSPULATORY - OPERATIONS SUMMARY ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
INHOSP ;
S X=999,DIC="^AUTTRCD(",DIC(0)="" D ^DIC S APCLAPCD=$S(Y>0:+Y,1:"")
I $G(APCLMFY)=1!(APCLMFY=3) S X1=APCLFYB,X2=-1 D C^%DTC S APCLSD=X_".9999",APCLED=APCLFYE,APCLOS="APCLOS" D V
I $G(APCLMFY)=2 S APCLSD=APCL("FY WORKING DT"),APCLED=APCLFYE,APCLOS="APCLOS" D V
D SET
S X1=APCLPYB,X2=-1 D C^%DTC S APCLSD=X_".9999",APCLED=APCLPYE,APCLOS="APCLOSP" D V
D SET
EOJ ;ENTRY POINT
K APCLSD,APCLODAT,APCLED,APCLVDFN,APCLVREC,APCLINJF,APCLALCH,APCLVLOC,APCL1,APCL2,APCLAP,APCLTYPE,APCLOLOC,APCLVLOC,APCLCLNC,APCLCLIN,APCLDDFN,APCLDENT,APCLF,APCLPOV,APCLINJ,APCLAPC,G
K APCLX,APCLPROV,APCLY,APCLDISC,APCLPDFN,APCLA,APCLH,APCLD,APCLINHO,APCLEDAT,APCLL,APCLS,APCLC,APCLT,APCLP,APCLF,APCLH,APCLAPCD
Q
V ;
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLA=%_"""INHOSPPOV"",APCLPOV)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLH=%_"""INHOSPAPC"",APCLAPC)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLD=%_"""INHOSPINJCAUSE"",APCLINJ)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLP=%_"""INHOSPPROV"",APCLDISC)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLT=%_"""INHOSPTYPE"",APCLTYPE)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLL=%_"""INHOSPLOC"",APCLVLOC)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLS=%_"""INHOSPOLOC"",APCLOLOC)"
S APCLODAT=APCLSD F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
Q
V1 ;
S APCLVDFN="" F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)) S APCLVREC=^(0) D PROC
Q
PROC ;
K APCLINJF,APCLALCH
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:'$P(APCLVREC,U,9)
Q:$P(APCLVREC,U,11)
Q:$P(APCLVREC,U,7)'="I"
;Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))
S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""
Q:'$D(^XTMP("APCLSU",APCLJOB,APCLBTH,APCLVLOC))
Q:'$D(^AUPNVPOV("AD",APCLVDFN))
S (APCL1,APCL2)=0 F S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2="" I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1,APCLAP=$P(^(0),U)
Q:APCL1=0
Q:APCL1>1
S ^("INHOSPVCOUNT")=$S($D(^XTMP(APCLOS,APCLJOB,APCLBTH,"INHOSPVCOUNT")):(+^("INHOSPVCOUNT")+1),1:1)
TYPE K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AUPNVSIT(",DR=".03",DA=APCLVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S APCLTYPE=^UTILITY("DIQ1",$J,9000010,APCLVDFN,.03,"E")
S X=APCLT D COUNT
OLOC ;
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AUPNVSIT(",DR="2101",DA=APCLVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S APCLOLOC=$G(^UTILITY("DIQ1",$J,9000010,APCLVDFN,2101,"E"))
S:APCLOLOC="" APCLOLOC="---not entered---"
S X=APCLS D COUNT
K ^UTILITY("DIQ1",$J)
LOC ;
S X=APCLL D COUNT
;
PROV D ^APCLOS61
Q
SET ;ENTRY POINT
S APCL1="INHOSPPOVC",APCL3="INHOSPPOV" D SET1
S APCL1="INHOSPAPCC",APCL3="INHOSPAPC" D SET1
S APCL1="INHOSPPROVC",APCL3="INHOSPPROV" D SET1
S APCL1="INHOSPTYPEC",APCL3="INHOSPTYPE" D SET1
S APCL1="INHOSPOLOCC",APCL3="INHOSPOLOC" D SET1
S APCL1="INHOSPLOCC",APCL3="INHOSPLOC" D SET1
Q
SET1 S APCL2="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"""_APCL3_""",X)"
S X="" F S X=$O(@APCL2) Q:X="" S %=^(X) S ^XTMP(APCLOS,APCLJOB,APCLBTH,APCL1,9999999-%,X)=%
Q
COUNT ;
I '$D(@X) S @X=0
S %=@X,%=%+1,@X=%
Q
APCLOS6 ; IHS/CMI/LAB - INHOSPULATORY - OPERATIONS SUMMARY ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
INHOSP ;
+1 SET X=999
SET DIC="^AUTTRCD("
SET DIC(0)=""
DO ^DIC
SET APCLAPCD=$SELECT(Y>0:+Y,1:"")
+2 IF $GET(APCLMFY)=1!(APCLMFY=3)
SET X1=APCLFYB
SET X2=-1
DO C^%DTC
SET APCLSD=X_".9999"
SET APCLED=APCLFYE
SET APCLOS="APCLOS"
DO V
+3 IF $GET(APCLMFY)=2
SET APCLSD=APCL("FY WORKING DT")
SET APCLED=APCLFYE
SET APCLOS="APCLOS"
DO V
+4 DO SET
+5 SET X1=APCLPYB
SET X2=-1
DO C^%DTC
SET APCLSD=X_".9999"
SET APCLED=APCLPYE
SET APCLOS="APCLOSP"
DO V
+6 DO SET
EOJ ;ENTRY POINT
+1 KILL APCLSD,APCLODAT,APCLED,APCLVDFN,APCLVREC,APCLINJF,APCLALCH,APCLVLOC,APCL1,APCL2,APCLAP,APCLTYPE,APCLOLOC,APCLVLOC,APCLCLNC,APCLCLIN,APCLDDFN,APCLDENT,APCLF,APCLPOV,APCLINJ,APCLAPC,G
+2 KILL APCLX,APCLPROV,APCLY,APCLDISC,APCLPDFN,APCLA,APCLH,APCLD,APCLINHO,APCLEDAT,APCLL,APCLS,APCLC,APCLT,APCLP,APCLF,APCLH,APCLAPCD
+3 QUIT
V ;
+1 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLA=%_"""INHOSPPOV"",APCLPOV)"
+2 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLH=%_"""INHOSPAPC"",APCLAPC)"
+3 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLD=%_"""INHOSPINJCAUSE"",APCLINJ)"
+4 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLP=%_"""INHOSPPROV"",APCLDISC)"
+5 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLT=%_"""INHOSPTYPE"",APCLTYPE)"
+6 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLL=%_"""INHOSPLOC"",APCLVLOC)"
+7 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLS=%_"""INHOSPOLOC"",APCLOLOC)"
+8 SET APCLODAT=APCLSD
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+9 QUIT
V1 ;
+1 SET APCLVDFN=""
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
SET APCLVREC=^(0)
DO PROC
+2 QUIT
PROC ;
+1 KILL APCLINJF,APCLALCH
+2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+3 IF '$PIECE(APCLVREC,U,9)
QUIT
+4 IF $PIECE(APCLVREC,U,11)
QUIT
+5 IF $PIECE(APCLVREC,U,7)'="I"
QUIT
+6 ;Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))
+7 SET APCLVLOC=$PIECE(APCLVREC,U,6)
IF APCLVLOC=""
QUIT
+8 IF '$DATA(^XTMP("APCLSU",APCLJOB,APCLBTH,APCLVLOC))
QUIT
+9 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
+10 SET (APCL1,APCL2)=0
FOR
SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))
IF APCL2=""
QUIT
IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"
SET APCL1=APCL1+1
SET APCLAP=$PIECE(^(0),U)
+11 IF APCL1=0
QUIT
+12 IF APCL1>1
QUIT
+13 SET ^("INHOSPVCOUNT")=$SELECT($DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"INHOSPVCOUNT")):(+^("INHOSPVCOUNT")+1),1:1)
TYPE KILL ^UTILITY("DIQ1",$JOB)
+1 KILL DIQ,DIC,DA,DR
+2 SET DIC="^AUPNVSIT("
SET DR=".03"
SET DA=APCLVDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+3 SET APCLTYPE=^UTILITY("DIQ1",$JOB,9000010,APCLVDFN,.03,"E")
+4 SET X=APCLT
DO COUNT
OLOC ;
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL DIQ,DIC,DA,DR
+3 SET DIC="^AUPNVSIT("
SET DR="2101"
SET DA=APCLVDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+4 SET APCLOLOC=$GET(^UTILITY("DIQ1",$JOB,9000010,APCLVDFN,2101,"E"))
+5 IF APCLOLOC=""
SET APCLOLOC="---not entered---"
+6 SET X=APCLS
DO COUNT
+7 KILL ^UTILITY("DIQ1",$JOB)
LOC ;
+1 SET X=APCLL
DO COUNT
+2 ;
PROV DO ^APCLOS61
+1 QUIT
SET ;ENTRY POINT
+1 SET APCL1="INHOSPPOVC"
SET APCL3="INHOSPPOV"
DO SET1
+2 SET APCL1="INHOSPAPCC"
SET APCL3="INHOSPAPC"
DO SET1
+3 SET APCL1="INHOSPPROVC"
SET APCL3="INHOSPPROV"
DO SET1
+4 SET APCL1="INHOSPTYPEC"
SET APCL3="INHOSPTYPE"
DO SET1
+5 SET APCL1="INHOSPOLOCC"
SET APCL3="INHOSPOLOC"
DO SET1
+6 SET APCL1="INHOSPLOCC"
SET APCL3="INHOSPLOC"
DO SET1
+7 QUIT
SET1 SET APCL2="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"""_APCL3_""",X)"
+1 SET X=""
FOR
SET X=$ORDER(@APCL2)
IF X=""
QUIT
SET %=^(X)
SET ^XTMP(APCLOS,APCLJOB,APCLBTH,APCL1,9999999-%,X)=%
+2 QUIT
COUNT ;
+1 IF '$DATA(@X)
SET @X=0
+2 SET %=@X
SET %=%+1
SET @X=%
+3 QUIT
