ADGPTLC1.m

ADGPTLC1 ; IHS/ADC/PDW/ENM - CALCULATE DAY SURGERY LIST ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 ;***> find all day surgery patients on inpatient wards

 S DGW=0

A1 S DGW=$O(^ADGDS("CN",DGW)) G NEXT:DGW=""

 I DGWST,(DGW'=DGWST) G A1

 S DFN=0

A2 S DFN=$O(^ADGDS("CN",DGW,DFN)) G A1:DFN="" S DGDS=0

A3 S DGDS=$O(^ADGDS("CN",DGW,DFN,DGDS)) G A2:DGDS=""

 ;

 S (DGNM,DGWD,DGBED,DGRM,DGAD,DGDX,DGSER,DGPRV,DGCOM)=""

 I $D(^ADGDS(DFN,"DS",DGDS,2)),$P(^(2),U)'="" G A3

 G A3:'$D(^ADGDS(DFN,"DS",DGDS,0)) S DGSTR=^(0)

 S DGNM=$P($G(^DPT(DFN,0)),U)

 S DGWD=DGW,DGBED=$P(DGSTR,U,4),DGRM=DGWD_"-"_DGBED

 S DGSER=$P(DGSTR,U,5),DGPRV=$P(DGSTR,U,6)

 S DGCOM=$P($G(^AUPNPAT(DFN,11)),U,18)

 S DGAD=$P(DGSTR,U,1) I DGO=1!(DGO=4) S DGDX=$P(DGSTR,U,2)

 S:DGO=2 DGDX=DGSER

 I DGO=3 S ^TMP("DGZPTL",$J,"A",DGNM,DFN)=DGRM_U_DGAD_U_DGSER_U_DGPRV_U_DGCOM_"^DS" G A2

 I $P(DGRM,"-",2)="" S ^TMP("DGZPTL",$J,"WD",DGRM,DFN)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_"^DS" G A2

 S ^TMP("DGZPTL",$J,"WD",DGRM)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_"^DS" G A2

 ;

 ;

NEXT ; -- now look at surgery file for observation patients

 G END:'$D(^SRF("AIHS1","OB"))

 S DGDS=0 F  S DGDS=$O(^SRF("AIHS1","OB",DGDS)) Q:'DGDS  D

 . S DR=".01;.011;.04;.09;.14;.22;10;32:34;9999999.04;9999999.05"

 . K DGRR D ENP^XBDIQ1(130,DGDS,DR,"DGRR(","I")

 . I DGWST,DGRR(9999999.04,"I")'=DGWST Q

 . S DGNM=DGRR(.01),DFN=DGRR(.01,"I"),DGAD=$$SDT,DGPRV=DGRR(.14,"I")

 . S DGSER=DGRR(.04),DGRM=DGRR(9999999.04)_"-"_DGRR(9999999.05)

 . S DGCOM=$$VAL^XBDIQ1(9000001,DFN,1118),DGDX=$$DX,DGST=DGRR(.011,"I")

 . S:DGO=2 DGDX=DGSER

 . I DGO=3 S ^TMP("DGZPTL",$J,"A",DGNM,DFN)=DGRM_U_DGAD_U_DGSER_U_DGPRV_U_DGCOM_U_DGST Q

 . I $P(DGRM,"-",2)="" S ^TMP("DGZPTL",$J,"WD",DGRM,DFN)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_U_DGST Q

 . S ^TMP("DGZPTL",$J,"WD",DGRM)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_U_DGST Q

 ;

 ;

END K DGDS,DGW,DGWD,DGNM,DGBED,DGRM,DGAD,DGDX,DGSER,DGPRV,DGCOM Q

 ;

SDT() ; -- returns most current surgery date/time

 I DGRR(.22)]"" Q DGRR(.22,"I")

 I DGRR(10)]"" Q DGRR(10,"I")

 Q DGRR(.09,"I")

 ;

DX() ; -- returns most current dx

 I DGRR(34)]"" Q DGRR(34)

 I DGRR(32)]"" Q DGRR(32)

 Q DGRR(33)

ADGPTLC1  ; IHS/ADC/PDW/ENM - CALCULATE DAY SURGERY LIST ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3       ;***> find all day surgery patients on inpatient wards

 +4        SET DGW=0

A1         SET DGW=$ORDER(^ADGDS("CN",DGW))

           IF DGW=""

               GOTO NEXT

 +1        IF DGWST

               IF (DGW'=DGWST)

                   GOTO A1

 +2        SET DFN=0

A2         SET DFN=$ORDER(^ADGDS("CN",DGW,DFN))

           IF DFN=""

               GOTO A1

           SET DGDS=0

A3         SET DGDS=$ORDER(^ADGDS("CN",DGW,DFN,DGDS))

           IF DGDS=""

               GOTO A2

 +1       ;

 +2        SET (DGNM,DGWD,DGBED,DGRM,DGAD,DGDX,DGSER,DGPRV,DGCOM)=""

 +3        IF $DATA(^ADGDS(DFN,"DS",DGDS,2))

               IF $PIECE(^(2),U)'=""

                   GOTO A3

 +4        IF '$DATA(^ADGDS(DFN,"DS",DGDS,0))

               GOTO A3

           SET DGSTR=^(0)

 +5        SET DGNM=$PIECE($GET(^DPT(DFN,0)),U)

 +6        SET DGWD=DGW

           SET DGBED=$PIECE(DGSTR,U,4)

           SET DGRM=DGWD_"-"_DGBED

 +7        SET DGSER=$PIECE(DGSTR,U,5)

           SET DGPRV=$PIECE(DGSTR,U,6)

 +8        SET DGCOM=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)

 +9        SET DGAD=$PIECE(DGSTR,U,1)

           IF DGO=1!(DGO=4)

               SET DGDX=$PIECE(DGSTR,U,2)

 +10       IF DGO=2

               SET DGDX=DGSER

 +11       IF DGO=3

               SET ^TMP("DGZPTL",$JOB,"A",DGNM,DFN)=DGRM_U_DGAD_U_DGSER_U_DGPRV_U_DGCOM_"^DS"

               GOTO A2

 +12       IF $PIECE(DGRM,"-",2)=""

               SET ^TMP("DGZPTL",$JOB,"WD",DGRM,DFN)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_"^DS"

               GOTO A2

 +13       SET ^TMP("DGZPTL",$JOB,"WD",DGRM)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_"^DS"

           GOTO A2

 +14      ;

 +15      ;

NEXT      ; -- now look at surgery file for observation patients

 +1        IF '$DATA(^SRF("AIHS1","OB"))

               GOTO END

 +2        SET DGDS=0

           FOR 

               SET DGDS=$ORDER(^SRF("AIHS1","OB",DGDS))

               IF 'DGDS

                   QUIT 

               Begin DoDot:1

 +3                SET DR=".01;.011;.04;.09;.14;.22;10;32:34;9999999.04;9999999.05"

 +4                KILL DGRR

                   DO ENP^XBDIQ1(130,DGDS,DR,"DGRR(","I")

 +5                IF DGWST

                       IF DGRR(9999999.04,"I")'=DGWST

                           QUIT 

 +6                SET DGNM=DGRR(.01)

                   SET DFN=DGRR(.01,"I")

                   SET DGAD=$$SDT

                   SET DGPRV=DGRR(.14,"I")

 +7                SET DGSER=DGRR(.04)

                   SET DGRM=DGRR(9999999.04)_"-"_DGRR(9999999.05)

 +8                SET DGCOM=$$VAL^XBDIQ1(9000001,DFN,1118)

                   SET DGDX=$$DX

                   SET DGST=DGRR(.011,"I")

 +9                IF DGO=2

                       SET DGDX=DGSER

 +10               IF DGO=3

                       SET ^TMP("DGZPTL",$JOB,"A",DGNM,DFN)=DGRM_U_DGAD_U_DGSER_U_DGPRV_U_DGCOM_U_DGST

                       QUIT 

 +11               IF $PIECE(DGRM,"-",2)=""

                       SET ^TMP("DGZPTL",$JOB,"WD",DGRM,DFN)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_U_DGST

                       QUIT 

 +12               SET ^TMP("DGZPTL",$JOB,"WD",DGRM)=DFN_U_DGNM_U_DGAD_U_DGDX_U_DGPRV_U_DGCOM_U_DGST

                   QUIT 

               End DoDot:1

 +13      ;

 +14      ;

END        KILL DGDS,DGW,DGWD,DGNM,DGBED,DGRM,DGAD,DGDX,DGSER,DGPRV,DGCOM

           QUIT 

 +1       ;

SDT()     ; -- returns most current surgery date/time

 +1        IF DGRR(.22)]""

               QUIT DGRR(.22,"I")

 +2        IF DGRR(10)]""

               QUIT DGRR(10,"I")

 +3        QUIT DGRR(.09,"I")

 +4       ;

DX()      ; -- returns most current dx

 +1        IF DGRR(34)]""

               QUIT DGRR(34)

 +2        IF DGRR(32)]""

               QUIT DGRR(32)

 +3        QUIT DGRR(33)