- 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
