BSDCO1.m

BSDCO1 ; IHS/ANMC/LJF - IHS CHECK-OUT PROCESS ;  [ 02/10/2005  4:02 PM ]

 ;;5.3;PIMS;**1002,1010**;APR 26, 2002

 ;

 ;cmi/anch/maw 05/01/2009 PATCH 1010 RQMT 34 checkout date/time on visit

 Q

 ;

CO(SDOE,DFN,SDT,SDCL) ;EP; called to ask check-out date/time

 ;  Called by SDCO1

 ; SDOE = Oupatient Encounter IEN

 ;  DFN = Patient IEN

 ;  SDT = Appointment Date/Time

 ; SDCL = Clinic IEN

 ;

 I '$G(SDOE) D ^%ZTER Q  ;lets trap an error here to see what is causing the problem

 NEW DIE,DA,DR,SDN,SDV,AUPNVSIT

 S DIE="^SC("_SDCL_",""S"","_SDT_",1,"

 S DA(2)=SDCL,DA(1)=SDT,(DA,SDN)=$$SCIEN^BSDU2(DFN,SDCL,SDT)

 ;

 I $P($G(^SC(+SDCL,"S",SDT,1,SDN,"C")),U)="" D  Q

 . W !!,"Patient NOT checked in; Cannot check-out yet."

 . D PAUSE^BDGF

 ;

 ;IHS/ITSC/WAR 1/20/2005 PATCH #1002 to correctly identify ck-out 'user'

 ;S DR="303R//NOW;304///"_DUZ_";306///"_$$NOW^XLFDT

 S DR="303R//NOW;304///`"_DUZ_";306///"_$$NOW^XLFDT

 D ^DIE

 ;

 ; if checked out and status not updated, do it now

 I $P($G(^SC(+SDCL,"S",SDT,1,DA,"C")),U,3)]"" D

 . Q:$$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"

 . S DIE=409.68,DA=SDOE,DR=".12///2;.07///"_$$NOW^XLFDT

 . D ^DIE

 . ;

 . ; if visit pointer stored, update visit checkout date/time

 . S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I") Q:'SDV

 . Q:'$D(^AUPNVSIT(SDV,0))  Q:$$GET1^DIQ(9000010,SDV,.05,"I")'=DFN

 . Q:$$GET1^DIQ(9000010,SDV,.11,"I")=1    ;deleted

 . ;

 . ;cmi/maw 5/1/2009 PATCH 1010 RQMT 34

 . S DIE="^AUPNVSIT(",DA=SDV

 . S DR=".18///"_$P($G(^SC(+SDCL,"S",SDT,1,SDN,"C")),U,3)

 . D ^DIE S AUPNVSIT=SDV D MOD^AUPNVSIT

 Q

 ;

BSDCO1    ; IHS/ANMC/LJF - IHS CHECK-OUT PROCESS ;  [ 02/10/2005  4:02 PM ]

 +1       ;;5.3;PIMS;**1002,1010**;APR 26, 2002

 +2       ;

 +3       ;cmi/anch/maw 05/01/2009 PATCH 1010 RQMT 34 checkout date/time on visit

 +4        QUIT 

 +5       ;

CO(SDOE,DFN,SDT,SDCL) ;EP; called to ask check-out date/time

 +1       ;  Called by SDCO1

 +2       ; SDOE = Oupatient Encounter IEN

 +3       ;  DFN = Patient IEN

 +4       ;  SDT = Appointment Date/Time

 +5       ; SDCL = Clinic IEN

 +6       ;

 +7       ;lets trap an error here to see what is causing the problem

           IF '$GET(SDOE)

               DO ^%ZTER

               QUIT 

 +8        NEW DIE,DA,DR,SDN,SDV,AUPNVSIT

 +9        SET DIE="^SC("_SDCL_",""S"","_SDT_",1,"

 +10       SET DA(2)=SDCL

           SET DA(1)=SDT

           SET (DA,SDN)=$$SCIEN^BSDU2(DFN,SDCL,SDT)

 +11      ;

 +12       IF $PIECE($GET(^SC(+SDCL,"S",SDT,1,SDN,"C")),U)=""

               Begin DoDot:1

 +13               WRITE !!,"Patient NOT checked in; Cannot check-out yet."

 +14               DO PAUSE^BDGF

               End DoDot:1

               QUIT 

 +15      ;

 +16      ;IHS/ITSC/WAR 1/20/2005 PATCH #1002 to correctly identify ck-out 'user'

 +17      ;S DR="303R//NOW;304///"_DUZ_";306///"_$$NOW^XLFDT

 +18       SET DR="303R//NOW;304///`"_DUZ_";306///"_$$NOW^XLFDT

 +19       DO ^DIE

 +20      ;

 +21      ; if checked out and status not updated, do it now

 +22       IF $PIECE($GET(^SC(+SDCL,"S",SDT,1,DA,"C")),U,3)]""

               Begin DoDot:1

 +23               IF $$GET1^DIQ(409.68,SDOE,.12)="CHECKED OUT"

                       QUIT 

 +24               SET DIE=409.68

                   SET DA=SDOE

                   SET DR=".12///2;.07///"_$$NOW^XLFDT

 +25               DO ^DIE

 +26      ;

 +27      ; if visit pointer stored, update visit checkout date/time

 +28               SET SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")

                   IF 'SDV

                       QUIT 

 +29               IF '$DATA(^AUPNVSIT(SDV,0))

                       QUIT 

                   IF $$GET1^DIQ(9000010,SDV,.05,"I")'=DFN

                       QUIT 

 +30      ;deleted

                   IF $$GET1^DIQ(9000010,SDV,.11,"I")=1

                       QUIT 

 +31      ;

 +32      ;cmi/maw 5/1/2009 PATCH 1010 RQMT 34

 +33               SET DIE="^AUPNVSIT("

                   SET DA=SDV

 +34               SET DR=".18///"_$PIECE($GET(^SC(+SDCL,"S",SDT,1,SDN,"C")),U,3)

 +35               DO ^DIE

                   SET AUPNVSIT=SDV

                   DO MOD^AUPNVSIT

               End DoDot:1

 +36       QUIT 

 +37      ;