VSITPUT1.m

VSITPUT1 ;ISD/RJP - Continued...Verify/set fields and file visit record ;6/20/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996

 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect

 ; the incorporation of the module into PCE.  For historical reference,

 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT

 ; patches.

 ;

 ;;2.0;VISIT TRACKING;**3**;Aug 12, 1996;

 ;

 ;Routine called by ^VSITPUT

 K DD,DO,DA,DIC,DIK,X,Y,DLAYGO

 L +^XTMP("VSIT CREATE",+$G(VSIT("PAT")),+VSIT("VDT")):0 Q:'$T

 D:+$G(DINUM)

 . S DLAYGO=9000010

 . S DIC="^AUPNVSIT("

 . S DIC(0)=""

 . S X=+VSIT("VDT")

 . D FILE^DICN

 . L:+Y>0 +^AUPNVSIT(+Y)

 . K DLAYGO,DIC,DD,DO,X

 D:'+$G(DINUM)

 . N VSITI

 . S VSITI=$P(^AUPNVSIT(0),"^",3)

 . F  S VSITI=VSITI+1 L +^AUPNVSIT(VSITI):1 Q:$T&'$D(^AUPNVSIT(VSITI))  L -^AUPNVSIT(VSITI)

 . S ^AUPNVSIT(VSITI,0)=VSIT("VDT")

 . S ^AUPNVSIT("B",VSIT("VDT"),VSITI)=""

 . L +^AUPNVSIT(0)

 . S ^AUPNVSIT(0)=$P(^AUPNVSIT(0),"^",1,2)_"^"_VSITI_"^"_($P(^(0),"^",4)+1)

 . L -^AUPNVSIT(0)

 . L:VSITI'>0 -^AUPNVSIT(VSITI)

 . S Y=VSITI_"^"_VSIT("VDT")_"^1"

 D:Y>0

 . S VSIT("IEN")=Y

 . S $P(^AUPNVSIT(+Y,0),"^",2,99)=$P(VSITREC(0),"^",2,99)

 . S:$G(VSITREC(21))]"" ^AUPNVSIT(+Y,21)=VSITREC(21)

 . S:$G(VSITREC(150))]"" ^AUPNVSIT(+Y,150)=VSITREC(150)

 . S:$G(VSITREC(800))]"" ^AUPNVSIT(+Y,800)=VSITREC(800)

 . S:$G(VSITREC(811))]"" ^AUPNVSIT(+Y,811)=VSITREC(811)

 . S:$G(VSITREC(812))]"" ^AUPNVSIT(+Y,812)=VSITREC(812)

 . S DA=+Y,DIK="^AUPNVSIT(" D IX1^DIK K DIK

 . ;

 . ;IHS/ITSC/LJF 6/19/2003 adding fields required by IHS

 . NEW DIE,DR S DIE="^AUPNVSIT(",DR="1104///^S X=$$UID^AUPNVSIT("_DA_")" D ^DIE

 . I $$GET1^DIQ(9999999.39,1,.16,"I")="V" D   ;if MFI site, need 2 more fields

 . . K DR S DR=".15///A;.36///"_$$GET1^DIQ(9999999.39,1,.01,"I") D ^DIE

 . ;

 . L -^AUPNVSIT(DA)

 L -^XTMP("VSIT CREATE",+$G(VSIT("PAT")),+VSIT("VDT"))

 K DD,DO,DA,DIC,DIK,X,Y,DLAYGO

 Q

VSITPUT1  ;ISD/RJP - Continued...Verify/set fields and file visit record ;6/20/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996

 +2       ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect

 +3       ; the incorporation of the module into PCE.  For historical reference,

 +4       ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT

 +5       ; patches.

 +6       ;

 +7       ;;2.0;VISIT TRACKING;**3**;Aug 12, 1996;

 +8       ;

 +9       ;Routine called by ^VSITPUT

 +10       KILL DD,DO,DA,DIC,DIK,X,Y,DLAYGO

 +11       LOCK +^XTMP("VSIT CREATE",+$GET(VSIT("PAT")),+VSIT("VDT")):0

           IF '$TEST

               QUIT 

 +12       IF +$GET(DINUM)

               Begin DoDot:1

 +13               SET DLAYGO=9000010

 +14               SET DIC="^AUPNVSIT("

 +15               SET DIC(0)=""

 +16               SET X=+VSIT("VDT")

 +17               DO FILE^DICN

 +18               IF +Y>0

                       LOCK +^AUPNVSIT(+Y)

 +19               KILL DLAYGO,DIC,DD,DO,X

               End DoDot:1

 +20       IF '+$GET(DINUM)

               Begin DoDot:1

 +21               NEW VSITI

 +22               SET VSITI=$PIECE(^AUPNVSIT(0),"^",3)

 +23               FOR 

                       SET VSITI=VSITI+1

                       LOCK +^AUPNVSIT(VSITI):1

                       IF $TEST&'$DATA(^AUPNVSIT(VSITI))

                           QUIT 

                       LOCK -^AUPNVSIT(VSITI)

 +24               SET ^AUPNVSIT(VSITI,0)=VSIT("VDT")

 +25               SET ^AUPNVSIT("B",VSIT("VDT"),VSITI)=""

 +26               LOCK +^AUPNVSIT(0)

 +27               SET ^AUPNVSIT(0)=$PIECE(^AUPNVSIT(0),"^",1,2)_"^"_VSITI_"^"_($PIECE(^(0),"^",4)+1)

 +28               LOCK -^AUPNVSIT(0)

 +29               IF VSITI'>0

                       LOCK -^AUPNVSIT(VSITI)

 +30               SET Y=VSITI_"^"_VSIT("VDT")_"^1"

               End DoDot:1

 +31       IF Y>0

               Begin DoDot:1

 +32               SET VSIT("IEN")=Y

 +33               SET $PIECE(^AUPNVSIT(+Y,0),"^",2,99)=$PIECE(VSITREC(0),"^",2,99)

 +34               IF $GET(VSITREC(21))]""

                       SET ^AUPNVSIT(+Y,21)=VSITREC(21)

 +35               IF $GET(VSITREC(150))]""

                       SET ^AUPNVSIT(+Y,150)=VSITREC(150)

 +36               IF $GET(VSITREC(800))]""

                       SET ^AUPNVSIT(+Y,800)=VSITREC(800)

 +37               IF $GET(VSITREC(811))]""

                       SET ^AUPNVSIT(+Y,811)=VSITREC(811)

 +38               IF $GET(VSITREC(812))]""

                       SET ^AUPNVSIT(+Y,812)=VSITREC(812)

 +39               SET DA=+Y

                   SET DIK="^AUPNVSIT("

                   DO IX1^DIK

                   KILL DIK

 +40      ;

 +41      ;IHS/ITSC/LJF 6/19/2003 adding fields required by IHS

 +42               NEW DIE,DR

                   SET DIE="^AUPNVSIT("

                   SET DR="1104///^S X=$$UID^AUPNVSIT("_DA_")"

                   DO ^DIE

 +43      ;if MFI site, need 2 more fields

                   IF $$GET1^DIQ(9999999.39,1,.16,"I")="V"

                       Begin DoDot:2

 +44                       KILL DR

                           SET DR=".15///A;.36///"_$$GET1^DIQ(9999999.39,1,.01,"I")

                           DO ^DIE

                       End DoDot:2

 +45      ;

 +46               LOCK -^AUPNVSIT(DA)

               End DoDot:1

 +47       LOCK -^XTMP("VSIT CREATE",+$GET(VSIT("PAT")),+VSIT("VDT"))

 +48       KILL DD,DO,DA,DIC,DIK,X,Y,DLAYGO

 +49       QUIT